PD ROM 1/PD ROM Volume I - Macintosh Software from BMUG (1988).iso/Graphics/Graphic Demos/New Aquarium/Aquarium3.pas

Pascal/Delphi Source File | 1988-04-24 | 18.8 KB | 648 lines | [TEXT/TPAS]

{       APRIL 23, 10PM - Latest version
        V2.0 (when menus work - for now, V1.9) (They work! They work!)

 This is an attempt to duplicate the program 'Aquarium,' which takes up a
    whopping 35K of disk space. My guess is that it could be done in less room.
    Also, a good chance to learn about PICT resources & CopyBits calls.
    The general gist is thus: 1) Open the ScrapBook file (or whichever one
    has the fish PICT in it); 2) Open a window over the entire screen;
    3) Move the fish around, bouncing it off of the window edges;
    4) Exit when the user presses a key or clicks the mouse button.

    Updates: Aquarium1 used 'BlockMove' to copy the fish in from an offscreen
        BitMap which was redrawn at every iteration, rather than draw
        it directly on the screen; Aquarium2 uses 4 offscreen bitmaps-
        instead of redrawing the offscreen bitmap and BlockMoving it, 2
        simply decides which fish to copy to the screen and does it.
        It is therefore about 8 times faster.
        The current version uses a LOT of new code for menus & general
        event handling.}

PROGRAM Aquarium2;

{$U-}               {Turn normal Unit usage off}
{$R-}               {Range checking off =$R-}
{$D+}               {Generate Debug symbols}
{$I+}               {Check I/O results}
{$B+}               {Set the Finder Bundle bit}
{$T APPLAqrm}       {Type & creator}
(*{$O DS Turbo's:Aquarium2.0 }*)    {Output file directory:name}

uses MemTypes, QuickDraw, OSIntf, ToolIntf, PackIntf;

CONST
Chicago     = SystemFont;
AppleID     = 128;
FileID      = 129;
EditID      = 130;
QuitItem    = 1;

VAR {Globals}
indx,
MaxWidth,
MaxHeight,
MinWidth,
MinHeight,
hdist,
vdist:          integer;
myDelay,
myTicks:        longInt;
FishRect,
bounds:         rect;       {for setting up the screen}
WhichFish,
visible:        boolean;
theWindP:       WindowPtr;
anevent:        eventRecord;
myPort:         grafPtr;
ProgramDone:    boolean;
PicHandle1,
PicHandle2,
PicHandle3,
PicHandle4:     PicHandle;
TempBits:       array[1..4] of BitMap;
AppleMenu,
FileMenu,
EditMenu:       MenuHandle;
where:          point;



{------------------- Whew! Now, on to the good stuff -------------------}



PROCEDURE debugger; inline $A9FF;   {crash into the debugger, not bomb box}



PROCEDURE crash;
BEGIN
    debugger;
END;



PROCEDURE Debug( Astr1, Astr2: str255);
VAR
    r:              rect;
    WindP:          WindowPtr;
    CurPort:        GrafPtr;
    b:              boolean;
    bEvent:         EventRecord;
BEGIN
    GetPort(CurPort);
    SetPort(MyPort);
    WITH thePort^.portBits.bounds DO
        SetRect( r, Left + 100, Top + 100, Right - 100, Bottom - 100);
    WindP := NewWindow( nil, r, '', visible, DBoxProc,
                                            Pointer(-1), True, 0);
    MoveTo (150, 150);
    TextFont(Chicago);
    TextSize(12);
    DrawString(Astr1);     {Probably Shouldn't use fixed coordinates}
    MoveTo (150, 180);
    DrawString(Astr2);
    REPEAT
        b := GetNextEvent(KeyDownMask + MDownMask, bEvent);
    UNTIL b;
    DisposeWindow(WindP);
    SetPort(CurPort);
END;


PROCEDURE SetUpScreen;
VAR
    a:      boolean;
BEGIN
    New(MyPort);                {get a GrafPtr}
    if MemError <> noErr then
    BEGIN
        SysBeep(1);
        debug('Out of RAM', '');
        repeat
            a := GetNextEvent( keyDownMask + mDownMask, anEvent);
            SystemTask;
        until a;
        ExitToShell;
    END;
    OpenPort(MyPort);
    bounds:= MyPort^.portBits.bounds;   {full screen size}
    bounds.top := bounds.top + 20;
    theWindP:= NewWindow( nil, bounds, '', visible, plainDBox,
                                            Pointer(-1), True, 0);
    if MemError <> noErr then
    BEGIN
        SysBeep(1);
        debug('Out of window RAM', '');
        repeat
            a := GetNextEvent( keyDownMask + mDownMask, anEvent);
            SystemTask;
        until a;
        ExitToShell;
    END;

    FillRect(bounds, white);
{ for inverted fish: do
    FillRect(bounds, black);  and see SetUpBitMaps}
end;

{ ---------------------------------- end SetUpScreen --------------- }



procedure Init;
BEGIN           {--------general initializing}
    MoreMasters;
    InitGraf(@thePort);
    Randseed := TickCount;
    InitFonts;
    FlushEvents(Everyevent, 0);
    InitWindows;
    InitMenus;
    TEInit;
    InitDialogs(@crash);
    InitCursor;
    PenNormal;
   {-------------------- program specific inits}
    myTicks := 0;
    visible:= true;
    SetUpScreen;        {get the port}
    MaxWidth := MyPort^.portrect.right;
    MaxHeight := MyPort^.portrect.bottom;
    MinWidth := MyPort^.portrect.left;
    MinHeight := MyPort^.portrect.top;
    programDone := false;
    TextFont(Geneva);
    TextSize(9);
    WhichFish := true;
end;



procedure ResFork;
VAR
    a:              boolean;
    TheError,
    TheRefNum:      integer;
    anEvent:        EventRecord;
    TheFileName:    String[63];
BEGIN
    TheError := noErr;
    a := false;
(*  theRefNum := OpenResFile( 'DS Turbo''s:XAquarium');*) {compile to RAM only}
    theRefNum := CurResFile;        {compile to disk ONLY}
                                    {get our appl rsrc file ref# to use}
    TheError:= ResError;
    If TheError <> noErr then
    BEGIN
        Debug('Resource file not found', '');
        ExitToShell;
    END {if};
END;



PROCEDURE GetPic;
BEGIN
    PicHandle1 := GetPicture( -32760);     {rh, reg}
    PicHandle2 := GetPicture( -32762);     {rh, up}
    PicHandle3 := GetPicture( -32763);     {lh, reg}
    PicHandle4 := GetPicture( -32761);     {lh, up}
    if PicHandle1 = NIL then
    BEGIN
        Debug('PicHandle 1 bad', '');
        ExitToShell;
    END;
    if PicHandle2 = NIL then
    BEGIN
        Debug('PicHandle 2 bad', '');
        ExitToShell;
    END;
    if PicHandle3 = NIL then
    BEGIN
        Debug('PicHandle 3 bad', '');
        ExitToShell;
    END;
    if PicHandle4 = NIL then
    BEGIN
        Debug('PicHandle 4 bad', '');
        ExitToShell;
    END;
END;    {GetPic}



PROCEDURE GetMenus;
VAR
    a:          boolean;
    theError:   integer;
BEGIN
    theError := noErr;
    a := false;
    AppleMenu := GetMenu(128);
    FileMenu := GetMenu(129);
    EditMenu := GetMenu(130);
    theError := ResError;
    if theError <> noErr then
    BEGIN
        Debug('The Menus were not found', '');
        ExitToShell;
    END {if};

    AddResMenu( AppleMenu, 'DRVR');     {add the DAs}
    InsertMenu(AppleMenu, 0);
    InsertMenu(FileMenu, 0);
    InsertMenu(EditMenu, 0);
    DrawMenuBar;
END;



FUNCTION SetHDist: integer;
VAR
    newx:   integer;
BEGIN
    newx:= abs(random) mod 9;           {was mod 9 * 2}
    if newx = 0 then newx:= newx + 2;
    SetHDist:= newx;
END;



FUNCTION SetVDist: integer;
VAR
    newx:   integer;
BEGIN
    newx:= abs(random) mod 3;           {was mod 5}
    if newx = 0 then newx:= newx + 2;
    SetVDist:= newx;
    myDelay := trunc( random mod 20 / 3);     {ticks}
END;



PROCEDURE TestEdges;
BEGIN
        If FishRect.left >= MaxWidth - 30 then
        BEGIN
            hdist:= -SetHDist; {neg}
            if FrontWindow = theWindP then DisableItem(EditMenu, 0);
            DrawMenuBar;    {to show the now disabled Edit menu}
        END;

        If FishRect.bottom >= MaxHeight - 1 then
        BEGIN
            vdist:= -SetVDist; {neg}
            if FrontWindow = theWindP then DisableItem(EditMenu, 0);
            DrawMenuBar;
        END;

        If FishRect.right <= MinWidth + 30 then
        BEGIN
            hdist:= SetHDist; {pos}
            if FrontWindow = theWindP then DisableItem(EditMenu, 0);
            DrawMenuBar;
        END;

        If FishRect.top <= MinHeight + 21 then
        BEGIN
            vdist:= SetVDist;   {pos}
            if FrontWindow = theWindP then DisableItem(EditMenu, 0);
            DrawMenuBar;
        END;
END;            {TestEdges}



PROCEDURE SetUpBitMaps;
VAR
    currentPort:        GrafPtr;
    tempBMap:           BitMap;
    theSize:            size;   {of BitMap}
    indx:               integer;
    str1:               str255;
    a:                  boolean;
BEGIN
    { Note: we don't actually DRAW every time, we just COPY(bits) the
        correct pict onscreen.
        A- Set 4 rects to FishRect;
        B- Setup array of 4 offscreen bitmaps using FishRect as bounds;
        C- Draw the 4 fish into our 4 offscreen bitmaps;
        C- Use IF stmt to choose 1 of 4 bitmaps- i.e., "then theFish# := 1;"
        E- Use a single copy-to-screen statement:
             CopyBits(TempBits[theFish], tempBMap, TempBits[theFish].bounds,
                                            FishRect, srcCopy, nil);     }

    GetPort(currentPort);
    tempBMap := currentPort^.portbits;
    theSize := 38 * 164;        {=rowBytes * length}
          { (Trunc((FishRect.right - FishRect.left) / 8) + 1) *
                                (FishRect.bottom - FishRect.top);  }
    for indx := 1 to 4 do
    BEGIN
        TempBits[indx].baseAddr := NewPtr(theSize);
        if MemError <> noErr then
        BEGIN
            SysBeep(1);
            debug('Out of RAM, SetUpBitMaps', '');
            repeat
                a := GetNextEvent( keyDownMask + mDownMask, anEvent);
                SystemTask;
            until a;
            ExitToShell;
        END;

        TempBits[indx].rowBytes := 38;
                            {Trunc((FishRect.right-FishRect.left) / 8) + 1}
        TempBits[indx].bounds := FishRect;
    END;

    SetPortBits(TempBits[1]);
    DrawPicture( PicHandle1, TempBits[1].bounds);     {rh reg}
    SetPortBits(TempBits[2]);
    DrawPicture( PicHandle2, TempBits[2].bounds);     {rh uptail}
    SetPortBits(TempBits[3]);
    DrawPicture( PicHandle3, TempBits[3].bounds);     {lh reg}
    SetPortBits(TempBits[4]);
    DrawPicture( PicHandle4, TempBits[4].bounds);     {lh uptail}

{Note: for inverted fish, do the following ---
    for indx := 1 to 4 do
    BEGIN
        SetPortBits(TempBits[indx]);
        InvertRect(TempBits[indx].bounds);
    END;
        ---and also see SetUpScreen to paint whole screen black, not white.}

    SetPortBits(tempBMap);
END; {SetUpBitMaps}



PROCEDURE DrawTheFish( VAR FishRect: rect);
VAR
    OldBits:        BitMap;
    theTempBits:    BitMap;
    currPort:       GrafPtr;
    aSize:          size;
    TitlePoint,
    TitlePoint1:    point;
    theFish:        integer;
BEGIN
    {By the way, we don't have to 'undraw' the fish, because the white
        edge of the fish PICTure will always act as an eraser for the
        previous time. This is true as long as we don't move the fish
        a distance farther than the thickness of the border, about 30 pixels.}

    IF FrontWindow <> theWindP then
        exit

   {*******IMPORTANT: some other window is in front of ours; therefore we
    don't want to draw. If they obliterate part of our drawing, we just
    fix it up after they go away.}

    ELSE
        SetPort(MyPort);  {make sure it's our port}

    oldBits := MyPort^.portbits;    {set oldBits to original BitMap}
    aSize := 38 * 164;              {rowBytes * length}

                     { ------- DRAW HERE -------- }
    OffSetRect(Fishrect, hDist, vDist);     {move the actual rect coords}
    IF WhichFish then
        if hdist > 0 then       {right-going fish}
            theFish := 1        {rh reg}
        else                    {left-going fish}
            theFish := 3        {lh reg}
    ELSE
        if hdist > 0 then
            theFish := 2        {rh up}
        else
            theFish := 4;       {lh up}
    WhichFish := NOT WhichFish;             {flip the fish: reg/uptail}

        {copy off-screen bitmap to on screen}
    CopyBits(TempBits[theFish], oldBits, TempBits[theFish].bounds,
                                                FishRect, SrcCopy, nil);
{Note: if the CopyBits destRect is not EXACTLY the same size as the SourceRect,
        you will see speed degradation & possibly image distortion.}

    MoveTo(225, 14);                    {drawing into screenBits}
    TextFont(Chicago);
    TextSize(12);
    DrawString('Aquarium');
    MoveTo(bounds.left, bounds.top - 1);
    LineTo(bounds.right, bounds.top - 1);
    SetPortBits(oldBits);
END;



PROCEDURE DoAbout;
VAR
    WindP:      WindowPtr;
    SnailRect,
    Wbounds:    rect;
    b:          boolean;
    bEvent:     EventRecord;
    CurPort:    GrafPtr;
    SnailPict:  PicHandle;
    VersStr,
    DateStr:    StringHandle;
BEGIN
    GetPort(CurPort);   {this fixed a nasty crashing problem w/MiniWriter DA}
    SetPort(MyPort);
    WITH thePort^.portBits.bounds DO
        SetRect( Wbounds, Left + 100, Top + 100, Right - 100, Bottom - 100);
    WindP := NewWindow( nil, Wbounds, '', visible, DBoxProc,
                                            Pointer(-1), True, 0);
    MoveTo (150, 150);
    TextFont(Chicago);
    TextSize(12);
    DrawString('Aquarium');     {Probably Shouldn't use fixed coordinates}
    MoveTo (150, 170);
    VersStr := GetString( 128);    {version STR rsrc}
    DrawString(VersStr^^);
    MoveTo (150, 190);
    DateStr := GetString( 129);    {Date STR rsrc}
    DrawString(DateStr^^);
    SnailPict := GetPicture(-32758);
    if ResError <> noErr then
    BEGIN
        DisposeWindow(WindP);
        exit;
    END;
    SetRect(SnailRect, 300, 153, 395, 199);
    {right side, bottom of top text line}
    DrawPicture(SnailPict, SnailRect);
    REPEAT
        b := GetNextEvent(KeyDownMask + MDownMask, bEvent);
    UNTIL b;
    DisposeWindow(WindP);
    SetPort(CurPort);
END;



PROCEDURE DoMouseDown;
VAR
    WhichWindow:    WindowPtr;
    thePart:        integer;
    dragRect:       rect;


    PROCEDURE DoMenuClick;
    VAR
        MenuChoice:     longint;
        temp,
        theMenu,
        theItem:        integer;
        tempStr:        Str255;


    BEGIN   {DoMenuClick}
        MenuChoice := MenuSelect( anEvent.where);
        if MenuChoice <> 0 then
        BEGIN
            theMenu := HiWord(MenuChoice);
            theItem := LoWord(MenuChoice);
            CASE theMenu OF
                AppleID:    IF theItem = 1 then
                                BEGIN
                                    doAbout;
                                END
                            ELSE
                                BEGIN
                                    EnableItem(EditMenu, 0);
                                    EnableItem(EditMenu, 1);
                                    EnableItem(EditMenu, 3);
                                    EnableItem(EditMenu, 4);
                                    EnableItem(EditMenu, 5);
                                    EnableItem(EditMenu, 6);
                                    DrawMenuBar;
                                    GetItem(AppleMenu, theItem, tempStr);
                                    temp := OpenDeskAcc(tempStr);
                                END;
                FileID:     IF theItem = QuitItem then
                                            ProgramDone := true;
                EditID:     if SystemEdit(theItem - 1) then; {nothing- our
                                                     app doesn't use Edit menu}
            END;    {case}

            HiliteMenu(0);
        END;    {if MenuChoice...}
    END;        {DoMenuClick}


BEGIN   {DoMouseDown}
    thePart := FindWindow(anEvent.where, whichWindow);
    CASE thePart OF
        InDesk:         {do nothing};
        InMenuBar:      DoMenuClick;
        InSysWindow:    SystemClick(anEvent, whichWindow);
        InContent:      if whichWindow <> FrontWindow then
                            SelectWindow(whichWindow);
        InDrag:         {do nothing};
        InGrow:         {do nothing};
        InGoAway:       {don't have one};
    END;    {case}
END;



PROCEDURE DoKeyDown;
VAR
    MenuChoice:     LongInt;
    temp,
    theMenu,
    theItem:        Integer;
    tempStr:        Str255;
BEGIN
    IF BitAnd(anEvent.modifiers, cmdKey) <> 0 then
    BEGIN
        MenuChoice := MenuKey( CHR( LoWord(anEvent.message)));
        if MenuChoice <> 0 then
        BEGIN
            theMenu := HiWord(MenuChoice);
            theItem := LoWord(MenuChoice);
            CASE theMenu OF
                AppleID:    IF theItem = 1 then
                                BEGIN
                                    DoAbout;
                                END
                            ELSE
                                BEGIN
                                    EnableItem(EditMenu, 0);
                                    EnableItem(EditMenu, 1);
                                    EnableItem(EditMenu, 3);
                                    EnableItem(EditMenu, 4);
                                    EnableItem(EditMenu, 5);
                                    EnableItem(EditMenu, 6);
                                    DrawMenuBar;
                                    GetItem(AppleMenu, theItem, tempStr);
                                    temp := OpenDeskAcc(tempStr);
                                END;
                FileID:     IF theItem = QuitItem then
                                            ProgramDone := true;
                EditID:     if SystemEdit(theItem - 1) then;
            END;    {case}
            HiliteMenu(0);
        END;    {if MenuChoice...}
    END         {if BitAnd}
END;





BEGIN       {------------- MAIN PROGRAM LOOP ---------------}
    Init;               {Do all the stuff we don't want to see here}
    ResFork;            {open the Rsrc file}
    GetPic;             {get the 4 fish PICT resources into handles}
    GetMenus;           { "   "  menus}
    hDist := SetHDist;
    vDist := SetVDist;
    SetRect( FishRect, 1, 1, 302, 165);     {So the offscreen bitmaps are
                                                the right size}
    SetUpBitMaps;
    SetRect( FishRect, -302, 51, -1, 215);
                            {starting fish place =offscreen left}
    DisableItem(EditMenu, 0);

{------------ Done getting ready, now Go ----------------------------}

    REPEAT
        if GetNextEvent(everyEvent, anEvent) then
        CASE anEvent.what OF
            MouseDown:      DoMouseDown;
            KeyDown,
            autoKey:        DoKeyDown;
            upDateEvt:
               {BeginUpDate(theWindP); }
                BEGIN
                    TestEdges;
                    DrawTheFish( FishRect);
                    Delay(myDelay, myTicks);     {ticks}
                END;
               {EndUpDate(theWindP); }
        END;    {case}
        SystemTask;         {make the cursor blink, etc}
        GetMouse(where);
        if FrontWindow = theWindP then
            if where.v < 20 then
            BEGIN
                InitCursor;     {can't just ShowCursor, since
                                 we don't know how many times we've
                                 done a HideCursor}
            END
            else
                HideCursor;
    UNTIL ProgramDone;

    ReleaseResource( Handle( PicHandle1));
    ReleaseResource( Handle( PicHandle2));
    ReleaseResource( Handle( PicHandle3));
    ReleaseResource( Handle( PicHandle4));
    InitCursor;
END.